00100	C  SUBRS. VLINE, ASKIT, GRED, LPEN, SAVIT, LISTP ***************
00200	
00300	
00400		SUBROUTINE VLINE(R3,R4,R5,R6)
00500		INTEGER ASK
00600		COMMON /MKX/KSLA,ISEMI,LESS,IGT/A2Z/LAA,LBB,NONO(9),LEL
00700		COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK /IDEV/IDEV
00800		IF(R5.NE.0)GO TO 66 
00900	267 	IF(IDEV.EQ.5)
01000		1 CALL TYPSTR('TYPE STAFF #, POS1, POS2 AND CODE #  ')
01100	CRR** NEXT WITH NEW RREAD IN MS.F4   CAN NOW TYPE M 1 0 200 16, ETC.
01200		READ(IDEV,F78F,END=167)R3,R4,R5,R6
01300	CQQ	ACCEPT F78F,R3,R4,R5,R6
01400		REREAD FA1,ASK
01500		IF(ASK.EQ.LESS)GO TO 167
01600		CALL LO2UP(ASK)
01700		IF(ASK.NE.IGT)GO TO 2
01800		IDEV=1
01900		GO TO 267
02000	2	IF(ASK.EQ.LBB)R3=99
02100	C  99 IS ALSO USED IN MOVER.F4
02200		IF(R3.GE.99)RETURN
02300		IF(ASK.NE.LEL)GO TO 66
02400	C  TYPE 'L' FOR LIGHT-PEN
02500		K=-1
02600	67	R4=RY
02700		CALL LPEN(R3,RY,RX)
02800		REREAD FA1,ASK
02900		CALL LO2UP(ASK)
03000		IF(ASK.EQ.LBB)R3=99
03100		IF(R3.GE.99)RETURN
03200		K=-K
03300		IF(K.GT.0)GO TO 67
03400		R5=RY
03500	C LIGHT PEN IS READ TWICE
03600	66	ASK=-1
03700		IF(R6.LT.100)GO TO 1
03800		R6=R6-100
03900	C  FOR 'ASK' ADD 100 TO PARAM NUMBER GIVEN.
04000		ASK=0
04100	1	CALL BOX(-1,R4)
04200		CALL BOX(-2,R5)
04300	C  PUTS UP TWO VERTICAL LINES
04400		RETURN
04500	CCC3	FORMAT(' TYPE STAFF #, POS1, POS2 AND CODE #  '$)
04600	167	IDEV=5    
04700		GO TO 267
04800		END
04900	
05000	
05100		SUBROUTINE ASKIT
05200		INTEGER ASK
05300		COMMON /DPY/ST(4000),MEDIT,IGO/A2Z/NONO(6),LGG
05400		COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK
05500		COMMON /XRN/RN(1) /KJY/ K,JY
05600		IGO=0
05700		CALL DPYNEW
05800		X=ST(2)
05900		CALL BOX(JY,RN(JY+2))
06000		ST(2)=X
06100	  	CALL TYPSTR('N=NO, <CR>=YES, G=GO  ')
06200		ACCEPT FA1,K
06300		IF(K.EQ.LGG)ASK=-1
06400		CALL DPYNEW
06500		IGO=1
06600		END
06700	
06800		SUBROUTINE GRED
06900		INTEGER PWDS
07000		COMMON /MKX/KSLA,ISEMI,LESS,IGT
07100		1/A2Z/LAA,LBB,LCC,LDD,NONO(7),LEL,LMM,LNN,NON(9),LXX
07200		COMMON /DPY/IST(4000),MEDIT,IGO /IDEV/IDEV
07300		COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK /KJY/ K,JY
07400		COMMON/SCM/V(78),ISCR,LCNT,RSTF,LIST(200),REND
07500		COMMON R2,JA,J,J2,RJQ(6),RC,IZ,RX,KV,RY,IA,IB,C,D,JZ,A,
07600		1 NX,VY,RB,JQ(20) /XRN/RN(1) /ALF/INP(72),ML
07700		COMMON /PTR/PWDS(1) /POSI/STFF(8),JJB,POS
07800		1 /LIMIT/LIMIT,ITEM,L,I,IX
07900		1 /RINP/R(10,80),RPOS(100) /DPTR/IWDS(1)
08000	
08100		EQUIVALENCE (IST2,IST(2)),(I2,INP(2))
08200		RC=999
08300		RSTF=RC
08400	CC **CAN'T GET HERE ***IF(INP(1).NE.'A'.AND.INP(1).NE.'D')GO TO 1
08500	C  LEAVES ROUTINE
08600		POS=0
08700	C ABOVE FOR NEW RREAD IN MS.
08800	7	CALL VLINE(R2,Z,POS,RX)
08900	C  PUTS UP TWO VERTICAL LINES
09000		REREAD FA1,NX
09100		CALL LO2UP(NX)
09200		IF(NX.EQ.LBB)GO TO 170
09300		IF(R2.LT.99)GO TO 70
09400	170	JA=98
09500		RETURN
09600	70	IF(POS.EQ.0)POS=200
09700	C  0,0  DOES WHOLE STAFF
09800		IF(INP(1).NE.LAA)GO TO 4
09900	267	IF(IDEV.EQ.1)GO TO 467
10000		CALL TYPSTR(' TYPE P#, CHNG,  P#, CHNG,  P#, CHNG, ...')
10100		CALL TYPCRL
10200	467	READ(IDEV,F78F,END=167)V
10300	CQQ	ACCEPT F78F,V
10400		REREAD FA1,K
10500	C  TYPE 'L' FOR LIGHT PEN
10600		IF(K.EQ.LESS)GO TO 167
10700		CALL LO2UP(K)
10800		IF(K.NE.IGT)GO TO 367
10900		IDEV=1
11000		GO TO 267
11100	367	IF(V(1).EQ.99)GO TO 7
11200		IF(K.EQ.LBB)GO TO 7
11300	C TYPE 'B' OR 99 TO BACKUP
11400		IF(K.NE.LEL)GO TO 66
11500		DO 67 K=1,2
11600		V(2)=RY
11700		CALL LPEN(V(1),RY,RX)
11800		REREAD FA1,JA
11900		CALL LO2UP(JA)
12000		IF(JA.EQ.LBB)GO TO 7
12100	67	IF(V(1).GE.99)GO TO 7
12200		V(3)=RY
12300	66	JA=0
12400		IZ=0
12500	C  COUNTER
12600		GO TO 14
12700	167	IDEV=5
12800		GO TO 267
12900	4	JA=98
13000	C  DEL=FOR DELETIONS   CD=CENTER DASHES BETWEEN SYLLABLES.
13100		IF(I2.EQ.LDD)JA=0
13200	C  STF.N, -99    -- DELETES ALL BUT STAFF N.
13300		IF(Z.NE.-99)GO TO 14
13400		RSTF=R2
13500		R2=99
13600	14	NX=0
13700	C  LOOP STARTS HERE
13800		J=0
13900	140	NX=NX+1
14000	142	JY=PWDS(NX)
14100		RB=RN(JY+3)
14200		IF(RTLINE(JY))GO TO 6
14300		IF(RB.LT.Z)GO TO 6
14400		IF(RB.GT.POS)GO TO 6
14500		IF(RN(JY+2).EQ.RSTF)GO TO 6
14600	C  FOR -99 DELETES.
14700		RB=RN(JY+1)
14800	
14900		IF(I2.NE.LDD)GO TO 71
15000	C NEXT FOR 'CD'  CENTER DASHES WITH TEXT
15100		IF(RB.NE.4.)GO TO 6
15200		IF(RN(JY).LT.8.)GO TO 6
15300	C P10 MUST BE .GT.0
15400		CALL DASHES(ITEM,RN(JY+2),RN(JY+3))
15500		GO TO 6
15600	
15700	71	IF(V(1).EQ.12)GO TO 77
15800		IF(V(1).EQ.100)GO TO 341
15900	C USE P100 AND ANY CODE# TO CREATE CUES. I.E. MINI NOTES, RESTS, BEAMS.
16000		IF(RC.EQ.999)GO TO 143
16100	C  USE P12 TO INVERT STEM, BEAM AND SLURS ALL AT ONCE.
16200	C  SET 12 TO 1 WITH CODE 5 TO INVERT SLURS ONLY
16300	77	RC=0
16400		IF(RB.EQ.5)GO TO 141
16500		IF(RB.NE.6)GO TO 143
16600		IF(RX.EQ.1)GO TO 141
16700	143	IF(RX.NE.44.)GO TO 144
16800	C USE CODE 44 FOR ALL 'LINE' EXCEPT BARLINES.
16900		IF(RB.NE.4)GO TO 6
17000		IF(RN(JY).LE.2)GO TO 6
17100		GO TO 100
17200	144	IF(RB.NE.RX.AND.RX.NE.0)GO TO 6
17300	CXX	IF(ASK)GO TO 100
17400	CXX	CALL ASKIT
17500	CXX	IF(K.EQ.LNN)GO TO 6
17600	CXX	IF(K.EQ.LXX)GO TO 19
17700	100	IF(INP(1).EQ.LAA)GO TO 141
17800		IF(J)GO TO 40
17900		J=-1
18000		K=NX
18100	41	IZ=NX
18200		IF(NX.LT.ITEM)GO TO 140
18300	40	IF(NX-IZ.EQ.1)GO TO 41
18400	C  GO BACK FOR MORE - IF IN RIGHT ORDER.
18500	C  RANGE TO DEL. = K→NX
18600	45	J=IZ+1
18700		IA=PWDS(K)
18800		IB=PWDS(J)-IA
18900		JZ=IWDS(K)
19000		J2=IWDS(J)-JZ
19100		J=J-K
19200		ITEM=ITEM-J
19300		DO 42 IZ=K,ITEM+1
19400		PWDS(IZ)=PWDS(IZ+J)-IB
19500	42	IWDS(IZ)=IWDS(IZ+J)-J2
19600		IST2=IST2-J2
19700		I=I-IB
19800		 CALL LOOP(IA,I,1,0,IB,RN)
19900		CALL LOOP(JZ+2,IST2+2,1,0,J2,IST)
20000		IF(K.GE.ITEM)GO TO 1
20100	C  EXITS
20200		NX=K+1
20300		GO TO 142
20400	341	IF(RB.EQ.6)GO TO 141
20500		IF(RB.GT.2)GO TO 6
20600	141	IF(IZ.GE.97)GO TO 9
20700	C   THERE'S A LIMIT TO THE R ARRAY    4/18/73
20800		IZ=IZ+1
20900	C  FOUND AN ITEM
21000		R(1,IZ)=223
21100	C 223 IS CODE NUMB. FOR EDIT MODE 
21200		R(2,IZ)=NX
21300	10	IZ=IZ+1
21400		DO 101 KV=3,10
21500	101	R(KV,IZ)=0
21600		IF(V(1).NE.100)GO TO 131
21700	231	R(1,IZ)=400
21800	C  MAKES MINI NOTES, RESTS, BEAMS
21900		R(2,IZ)=100
22000		GO TO 6
22100	131	IF(RC.EQ.999)GO TO 11
22200		IF(RB.EQ.1)GO TO 30
22300	31	RC=RN(JY+7)
22400		IF(RB.EQ.6)GO TO 32
22500	C  NEXT INVERTS DIP
22600		IF(RX.EQ.1)GO TO 35
22700		A=-1.6
22800		RB=-10
22900		IF(RC)A=-A
23000	CC***????  WHY CHANGE P2???  ****36	R(7,IZ)=2
23100	CC***	R(8,IZ)=RN(JY+2)+A
23200		GO TO 37
23300	35	RB=-4
23400		IF(RN(JY+8).LT.-1)RB=-1.4
23500	C  2 AND .7 ARE HGTS SET IN 'BEAMS'
23600	37	IF(RC)RB=-RB
23700		R(3,IZ)=4
23800		R(4,IZ)=RN(JY+4)+RB
23900		R(6,IZ)=RN(JY+5)+RB
24000		R(5,IZ)=5
24100	33	R(1,IZ)=7
24200		R(2,IZ)=-RC
24300		GO TO 6
24400	32	IF(RC.LT.20)GO TO 34
24500	C  THIS IS FOR BEAMS
24600	232	RC=10-RC
24700		GO TO 33
24800	132	IF(RC.GT.-20)GO TO 232
24900		GO TO 332
25000	34	IF(RC)GO TO 132
25100	C  P7 IS NEG FOR TREMOLOS
25200	332	RC=-10-RC
25300		GO TO 33
25400	
25500	C  NEXT INVERTS STEMS EITHER WAY. USE ANY #>11 WITH CODE 1 TO INVERT.
25600	C  MUST! BE FIRST IN LIST!!!
25700	C	RC=0
25800	30	RB=RN(JY+5)
25900		IF(RB.LT.10)GO TO 12
26000	C  NO STEM < 10
26100		RC=10
26200		IF(RB.GE.20)RC=-RC
26300		RB=RB+RC
26400	12	V(1)=5.
26500		V(2)=RB
26600	C  SO IT WILL DISPLAY RESULT
26700	11	DO 8 K=1,10
26800	8	R(K,IZ)=V(K)
26900	6	IF(J)GO TO 45
27000		IF(NX.LT.ITEM)GO TO 140
27100	19	IF(INP(1).NE.LAA)GO TO 1
27200	9	R(1,IZ+1)=222
27300		R(1,IZ+2)=0
27400	CC	REND=-1.
27500	1	CALL HYDPOG(3)
27600		END
27700	
27800		SUBROUTINE LPEN(A,B,C)
27900		COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK /SIZ/RSZ,JCEN,KCEN
28000		COMMON /POSI/STFF(0/7),JJ2,POS /ALF/INP(71),M,L /C/MM,LL
28100		COMMON /A2Z/LAA,LBB,NONO(21),LXX
28200		M=MM
28300		L=LL
28400		IF(IABS(M).GT.512)GO TO 4
28500		IF(IABS(L).LE.512)GO TO 3
28600	4	M=0
28700		L=100
28800	3	CALL SETCUR(M,L,0)
28900		CALL TYPSTR('TYPE <CR> TO SET POINT')
29000		ACCEPT FA1,JD
29100		IF(JD.EQ.'9')RETURN
29200		IF(JD.EQ.LXX)RETURN
29300	C  TYPE 'B' OR 99 TO BACK UP
29400		IF(JD.EQ.LBB)RETURN
29500		CALL RDCUR(M,L)
29600		L=(L+KCEN)/RSZ
29700	1	B=((M+JCEN)/RSZ+596.0)/5.96
29800	C  B=HORIZ. STEP NUM.
29900		DO 13 K=0,7
30000		M=STFF(K)+60.
30100		IF(L.GT.M)GO TO 13
30200		A=K
30300	C  A=STAFF NUM.
30400		GO TO 8
30500	13	CONTINUE
30600	8	C=IFIX((L-STFF(K)+21.)/7.+.5)
30700	C  FINDS VERT. NOTE NUM.
30800		TYPE F78F,A,B
30900		END
31000	
31100	
31200		SUBROUTINE SAVIT
31300		IMPLICIT INTEGER(A-Q,S-Z)
31400		COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK/DL/X22,SAVER,NAME,EXT
31500		1 /POSI/STFF(0/7),JJ2,IPOS /LIMIT/LIMIT,ITEM,L,I,IX 
31600		1 /SCM/V(78),ISCR,LCNT,IRSTF,LIST(200),REND  /IDEV/IDEV
31700		1 /ALF/INP(72),ML/XRN/RN(1)/DPY/ST(4000),MEDIT,IGO
31800		1 /STF/RSTFAC(0/7),RSTJ2 /PTR/PWDS(1) /JCHAR/IXX,ISEMI,IBLA
31900		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
32000		COMMON /A2Z/LAA,LBB,LCC,LDD,NONO(8),LMM,LNN,NON(4),LSS
32100		DIMENSION SV(128)
32200		EQUIVALENCE (INP2,INP(2)),(ST2,ST(2)),(SV,LIST)
32300	C  'SAME' WILL REPEAT CURRENT NAME.  BLANK WILL USE TMP.MS
32400		KX=-1
32500		K=0
32600	32	K=K+1
32700	C  THIS IS TO REPAIR DAMAGE DONE BY UNKNOWN BUGS!!!!
32800	33	L=PWDS(K)
32900		IA=PWDS(K+1)
33000		IB=RN(L)+3.+L
33100	C  THIS SHOULD BE NEW POINTER
33200		IF(IA-IB.EQ.0)GO TO 36
33300		IF(RN(IB)+3+IB.NE.PWDS(K+2))GO TO 38
33400		J=K+1
33500		PWDS(J)=IB
33600		CALL TYPSTR('?FIXED UP ITEM ')
33700		CALL TYPINT(J)
33800		CALL TYPCRL
33900		GO TO 36
34000	38	IJ=IA-L
34100		DO 39 J2=K+1,ITEM
34200	39	PWDS(J2)=PWDS(J2+1)-IJ
34300		CALL TYPSTR('BAD ITEM--')
34400		CALL TYPINT(K)
34500		CALL TYPCRL
34600		IF(KX.EQ.0)GO TO 50
34700		CALL TYPSTR('NAME.EXT? ')
34800		ACCEPT 141,INP
34900		CALL NAMEXT(INP,NAME,EXT)
35000	C  ONLY DOES THIS ON THE FIRST ERROR
35100		GO TO 2
35200	50	J=RJ
35300		KX=0
35400		CALL LOOP(L,I,1,0,J,RN)
35500	C  REARRANGES DATA
35600		I=I-J
35700		ITEM=ITEM-1
35800		IF(ITEM.LE.K)GO TO 37
35900		GO TO 33
36000	C  GO BACK AND TRY AGAIN
36100	36	IF(IA.LE.L)GO TO 38
36200	C  JUMP IF PWDS IS OUT OF ORDER
36300		IF(K.LT.ITEM)GO TO 32
36400	37	KX=-1
36500		IF(SAVER.GE.0)GO TO 10
36600		SAVER=5
36700	101	CALL PUTEXT('TMP','MS ')
36800		GO TO 102
36900	1	FORMAT(I,24F)
37000	2	CALL TYPCHR('WRITE OVER   ',13)
37100		CALL TYPWRD(NAME)
37200		CALL TYPCHR('.',1)
37300		CALL TYPCHR(EXT,3)
37400		CALL TYPCHR('?  ',3)
37500		ACCEPT 141,INP
37600		CALL LULOOP
37700		IF(INP(1).NE.LNN)GO TO 4
37800	10	IF(INP2.EQ.LMM)GO TO 4
37900	11	L=NAME
38000		INP(1)=-1
38100		CALL NAMEXT(INP,NAME,EXT)
38200		IF(NAME.NE.IBLA)GO TO 40
38300		CALL TYPSTR('NAME.EXT? ')
38400		ACCEPT 141,INP   
38500		CALL NAMEXT(INP,NAME,EXT)
38600		IF(NAME.EQ.IBLA)GO TO 4
38700	C 99 WILL BACK UP.
38800		IF(NAME.NE.'99')GO TO 40
38900		NAME=L
39000		RETURN
39100	40	IF(NAME.NE.'SAME')GO TO 43
39200		NAME=L
39300		GO TO 4
39400	141	FORMAT(72A1)
39500	43	IF(LOOKX(NAME,EXT))GO TO 2
39600	C  JUMP BACK IF FILE NAME ALREADY ON DSK
39700		IF(IDEV.NE.1)GO TO 4
39800		CALL TYPWRD(NAME)
39900		CALL TYPCHR('.',1)
40000		CALL TYPCHR(EXT,3)
40100		CALL TYPCRL
40200	4	IF(KX.EQ.0)GO TO 50
40300		IF(NAME.NE.IBLA)GO TO 41
40400		NAME=L
40500		GO TO 101
40600	41	CALL PUTEXT(NAME,EXT)
40700	42	IF(INP2.EQ.LDD)GO TO 202
40800	C   SB=SAVE BIG;  SD=SAVE DPY ONLY; SM=SB WITH SAME NAME
40900	102	IRSTF=0
41000		IF(INP2.EQ.LBB)IRSTF=-1
41100		JJ2=ITEM+2
41200		IPOS=I
41300	C WD CNTS
41400		CALL EXTOUT(RSTFAC,128)
41500	C  INCLUDES STFF AND V ARRAYS
41600	C***	CALL EXTOUT(PWDS,JJ2)
41700		CALL EXTOUT(RN,IPOS)
41800		IF(LCNT.GT.1)CALL EXTOUT(LIST,LCNT)
41900	CC102	WRITE(21)ITEM,I
42000	CC	1,(PWDS(L),L=1,ITEM+1),(RN(L),L=1,I-1),ISCR,(V(L),L=1,ISCR),
42100	CC	1 LCNT,(LIST(L),L=1,LCNT),RSTFAC,STFF,SV
42200	C (SV) FOR FORTRAN READ BUG!!!!
42300	CC	IF(SAVER.GE.0)WRITE(21)RSTFAC,STFF,L
42400	C NOT USED WHEN SAVE IS AUTOMATIC.
42500	C  TAKE OUT ABOVE WHEN BUG IS SOMEDAY FIXED IN F4.
42600		IF(I.LE.LIMIT)GO TO 20
42700		CALL TYPSTR('****** TOO MUCH DATA TO PRINT - ')
42800		CALL TYPINT(I)
42900		CALL TYPCHR('/',1)
43000		CALL TYPINT(LIMIT)
43100	20	IF(INP2.EQ.LBB)CALL EXTOUT(ST,4302)
43200	1001	CALL FINEXT
43300		IF(INP(1).NE.LSS)RETURN
43400		IF(NAME.NE.IBLA)RETURN
43500		CALL TYPSTR('DISPLAY SAVED IN "TMP.MS"')
43600		CALL TYPCRL
43700	C   GO BACK IF THE SAVER WROTE THE FILE
43800		RETURN
43900	202	WRITE(21),ST2,(ST(L),L=1,ST2+2)
44000	 	GO TO 1001
44100	C   WRITES DPY BUFFER ONLY.
44200		END
44300	
44400		SUBROUTINE LISTP(LST)
44500		IMPLICIT INTEGER(A-Q,S-Z)
44600		DIMENSION LST(1)
44700		COMMON/SCM/V(78),ISCR,LCNT,RSTF,LIST(200),REND/ALF/I1,I2,I3
44800		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(16),K,JY,X,Y /XRN/RN(1)
44900		1 /STF/RSTFAC(0/7),RSTJ2 /LIMIT/LIMIT,ITEM,L,I,IX /PTR/PWDS(1)
44950		1 /DL/X22,SAVER,NAME,EXT
45000		EQUIVALENCE (JC,JQ(1)),(JD,JQ(2)),(RJC,RJQ(1)),(RJD,RJQ(2))
45100		1 ,(RJE,RJQ(3))
45200	
45250		IF(I3.EQ.'X')CALL OFILE(22,NAME)
45300		JY=5
45400		IF(RJE.NE.0)JY=3
45500	CC	JD=RJD
45600	C  NO LPT FOR NOW    CC	IF(JD.NE.0)JY=3
45700	CC	DO 6334 L=IFIX(R2),JC
45800		JD=RJD
45900		IF(RJC.NE.0)GO TO 1
46000		RJC=1.
46100		JD=ITEM
46200	1	DO 6334 L=IFIX(RJC),JD
46300		X=PWDS(L)
46400		Y=RN(X)+2+X
46500	C1/81	X=X+1
46600	C1/81	K=RN(X)
46650		JK=RN(X+1)
46662		JL=RN(X+2)
46675		X=X+3
46700		IF(I3.NE.'X')GO TO 2
46800	C TYPE 'PRX' TO CREATE 'READ' FILE WITH ALL PARAMS.
46900		IF(JK.NE.16)WRITE(22,3)JK,JL,(RN(K),K=X,Y)
46910	C1/81  	WRITE(22,3)(RN(K),K=X,Y)
46920		IF(JK.EQ.16)WRITE(22,33)JK,JL,(RN(K),K=X,Y)
47000		GO TO 6334
47100	3	FORMAT(2I2,F8.2,F9.2,8F7.2)
47110	33	FORMAT(I2,I3,3F8.2,3F10.0,F7.2,F5.2)
47200	C* NOTICE -- WRITES LINES WHICH ARE TOO LONG! - THEY MUST BE EDITED.
47300	2	WRITE(JY,6333)L,LST(JK),JK,JL,(RN(K),K=X,Y)
47310	C1/81  2	WRITE(JY,6333),L,LST(K),(RN(K),K=X,Y)
47400	6334	CONTINUE
47500	C  P, N1, N2, N3  TYPES ITEM LIST. N1=1ST, N2=LAST, N3=TO LPT?
47600	C  LEAVE THIS HERE SO WRITE(JY, OF R IS POSSIBLE IN DDT
47700	6333	FORMAT(I4,') ',A5,I3,I2,F8.2,2F8.2,3F12.2,4F8.2)
47710	C1/81  6333	FORMAT(I4,') ',A5,2F4.0,F8.3,F8.2,7F10.2)
47800		IF(I3.NE.'X')RETURN
47900		END FILE 22
48000	C WRITES 'FOR22.DAT'
48100	C1/81	CALL TYPSTR('PARAMS WRITTEN ON FOR22.DAT')
48110		CALL TYPSTR('PARAMS WRITTEN ON ')
48155		CALL TYPCHR(NAME,5)
48177		CALL TYPSTR('.DAT')
48200		CALL TYPCRL
48300		END